{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit ItExport;

interface

uses
  Classes, SysUtils, VisualUtils, MiscUtils, Xdom_3_2, ItXmlizer, ZipWriter,
  ItCommon, cUnicodeCodecsWin32, TestCore, Profile;

function ModifierListToBytes(List: TModifierList): String;
function ProfileToBytes(Profile: TProfile): String;

implementation

const
  INDENT_CHARS = 2;

type
  TTestXmlWriteEvent = procedure(Xmlizer: TTestXmlizer) of object;

  TXmlTestWriter = class(TXmlTestEventSink)
  private
    FBuilder: TXmlStreamBuilder;
    FOpenElements: TStrings;
    FShortFormPossible: Boolean;
    FZipWriter: TZipWriter;
    procedure WriteStartDocument;
    procedure WriteCompleted;
    procedure WriteString(const ws: WideString);
    procedure WriteIndent;
    function CurrentElement: String;
  protected
    procedure BeginElement(const ElementName: String); override;
    procedure EndElement; override;
    procedure AddAttribute(const AttributeName, AttributeValue: String); override;
    procedure CreateFile(const FileName: String); override;
    function GetFileStream: TStream; override;
    procedure CloseFile; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Run(const OnWrite: TTestXmlWriteEvent; Output: TStream);
  end;

  TModifierListWriter = class
  private
    FSource: TModifierList;
    procedure Write(Xmlizer: TTestXmlizer);
  public
    constructor Create(Source: TModifierList);
  end;

  TProfileWriter = class
  private
    FSource: TProfile;
    procedure Write(Xmlizer: TTestXmlizer);
  public
    constructor Create(Source: TProfile);
  end;

procedure ExportFragmentToItStream(const OnWrite: TTestXmlWriteEvent; Output: TStream);
var
  Writer: TXmlTestWriter;
begin
  Writer := TXmlTestWriter.Create;
  try
    Writer.Run(OnWrite, Output);
  finally
    Writer.Free;
  end;
end;

function ModifierListToBytes(List: TModifierList): String;
var
  Writer: TModifierListWriter;
  Stream: TMemoryStream;
begin
  Writer := TModifierListWriter.Create(List);
  try
    Stream := TMemoryStream.Create;
    try
      ExportFragmentToItStream(Writer.Write, Stream);
      Stream.Seek(0, soFromBeginning);
      Result := ReadStreamTail(Stream);
    finally
      Stream.Free;
    end;
  finally
    Writer.Free;
  end;
end;

function ProfileToBytes(Profile: TProfile): String;
var
  Writer: TProfileWriter;
  Stream: TMemoryStream;
begin
  Writer := TProfileWriter.Create(Profile);
  try
    Stream := TMemoryStream.Create;
    try
      ExportFragmentToItStream(Writer.Write, Stream);
      Stream.Seek(0, soFromBeginning);
      Result := ReadStreamTail(Stream);
    finally
      Stream.Free;
    end;
  finally
    Writer.Free;
  end;
end;

{ TModifierListWriter }

constructor TModifierListWriter.Create(Source: TModifierList);
begin
  inherited Create;
  FSource := Source;
end;

procedure TModifierListWriter.Write(Xmlizer: TTestXmlizer);
begin
  Xmlizer.be(ELEM_TEST_FRAGMENT);
  Xmlizer.DoModifiers(FSource);
  Xmlizer.ee;
end;

{ TProfileWriter }

constructor TProfileWriter.Create(Source: TProfile);
begin
  inherited Create;
  FSource := Source;
end;

procedure TProfileWriter.Write(Xmlizer: TTestXmlizer);
begin
  Xmlizer.be(ELEM_TEST_FRAGMENT);
  Xmlizer.DoProfile(FSource);
  Xmlizer.ee;
end;

{ TXmlTestWriter }

procedure TXmlTestWriter.AddAttribute(const AttributeName,
  AttributeValue: String);
var
  s: TXmlAttributeSignal;
  w: WideString;
begin
  if Pos(#0, AttributeValue) <> 0 then
    raise Exception.CreateFmt('Value of the attribute "%s" contains null character.', [AttributeName]);

  w := UTF8Decode(AttributeValue);

  s := TXmlAttributeSignal.Create(nil, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
  try
    s.DataType := AS_STRING_DATATYPE;
    s.Name := AttributeName;
    s.Value := EscapeDelimiters(w);
    FBuilder.OutputSource.WriteLFOption := lwLF;
    FBuilder.ProcessSignal(s);
    FBuilder.OutputSource.WriteLFOption := lwCRLF;
  finally
    s.Free;
  end;
end;

procedure TXmlTestWriter.BeginElement(const ElementName: String);
var
  s: TXmlStartElementSignal;
begin
  WriteIndent;
  s := TXmlStartElementSignal.Create(nil, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
  try
    s.TagName := ElementName;
    FBuilder.ProcessSignal(s);
    FOpenElements.Add(ElementName);
  finally
    s.Free;
  end;
  FShortFormPossible := TRUE;
end;

procedure TXmlTestWriter.CloseFile;
begin
  FZipWriter.CloseEntry;
end;

constructor TXmlTestWriter.Create;
begin
  inherited;
  FOpenElements := TStringList.Create;
end;

procedure TXmlTestWriter.CreateFile(const FileName: String);
var
  Ext: String;
  cm: TCompressionMethod;
begin
  Ext := ExtractFileExt(FileName);
  if SameText(Ext, '.png') or SameText(Ext, '.jpg') then
    cm := cmStore
  else
    cm := cmDeflate;
  FZipWriter.CreateEntry(FileName, cm);
end;

function TXmlTestWriter.CurrentElement: String;
begin
  Assert( FOpenElements.Count > 0 );
  Result := FOpenElements[FOpenElements.Count-1];
end;

destructor TXmlTestWriter.Destroy;
begin
  FreeAndNil(FOpenElements);
  inherited;
end;

procedure TXmlTestWriter.EndElement;
var
  s: TXmlEndElementSignal;
  Elem: String;
begin
  Assert( FOpenElements.Count > 0 );
  Elem := FOpenElements[FOpenElements.Count-1];
  FOpenElements.Delete(FOpenElements.Count-1);
  if not FShortFormPossible then
    WriteIndent;
  s := TXmlEndElementSignal.Create(nil, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
  try
    s.TagName := Elem;
    s.ShortForm := FShortFormPossible;
    FBuilder.ProcessSignal(s);
  finally
    s.Free;
  end;
  FShortFormPossible := FALSE;
end;

function TXmlTestWriter.GetFileStream: TStream;
begin
  Result := FZipWriter.EntryStream;
end;

procedure TXmlTestWriter.Run(const OnWrite: TTestXmlWriteEvent; Output: TStream);
var
  XmlOutput: TXmlOutputSource;
  Xmlizer: TTestXmlizer;
  XmlStream: TMemoryStream;
begin
  FZipWriter := TZipWriter.Create(Output);
  try
    XmlStream := TMemoryStream.Create;
    try
      XmlOutput := TXmlOutputSource.Create(XmlStream, 4096);
      try
        Assert( FBuilder = nil );
        FBuilder := TXmlStreamBuilder.Create(nil);
        try
          FBuilder.OutputSource := XmlOutput;
          Xmlizer := TTestXmlizer.Create(Self);
          try
            FOpenElements.Clear;
            WriteStartDocument;

            OnWrite(Xmlizer);

            WriteCompleted;
            Assert( FOpenElements.Count = 0 );
          finally
            Xmlizer.Free;
          end;
        finally
          FBuilder.Free;
        end;
      finally
        XmlOutput.Free;
      end;

      XmlStream.Seek(0, soFromBeginning);
      FZipWriter.CreateEntry(IT_TEST_FILE_NAME, cmDeflate);
      FZipWriter.EntryStream.CopyFrom(XmlStream, 0);
      FZipWriter.CloseEntry;
    finally
      XmlStream.Free;
    end;

    FZipWriter.Commit;
  finally
    FreeAndNil(FZipWriter);
  end;
end;

procedure TXmlTestWriter.WriteCompleted;
var
  s: TXmlCompletedSignal;
begin
  s := TXmlCompletedSignal.Create(nil, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
  try
    FBuilder.ProcessSignal(s);
  finally
    s.Free;
  end;
end;

procedure TXmlTestWriter.WriteIndent;
begin
  WriteString(#10 + StringOfChar(' ', INDENT_CHARS * FOpenElements.Count));
end;

procedure TXmlTestWriter.WriteStartDocument;
var
  s: TXmlStartDocumentSignal;
begin
  s := TXmlStartDocumentSignal.Create(nil, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
  try
    s.EncodingName := 'utf-8';
    s.StandaloneDecl := STANDALONE_UNSPECIFIED;
    FBuilder.ProcessSignal(s);
  finally
    s.Free;
  end;
end;

procedure TXmlTestWriter.WriteString(const ws: WideString);
var
  s: TXmlPCDATASignal;
begin
  s := TXmlPCDATASignal.Create(nil, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
  try
    s.Data := ws;
    FBuilder.ProcessSignal(s);
  finally
    s.Free;
  end;
end;

end.
